indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## ── Attaching packages ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──## ✓ ggplot2 3.3.2 ✓ purrr 0.3.4
## ✓ tibble 3.0.1 ✓ dplyr 1.0.0
## ✓ tidyr 1.1.0 ✓ stringr 1.4.0
## ✓ readr 1.3.1 ✓ forcats 0.5.0## ── Conflicts ──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
#WRF C LOD values are coming up as NA, should be 0? Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: Ignoring 1 observations p2## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.p_combined <-
plotly::subplot(p2,p1, # plots to combine, top to bottom
nrows = 2,
heights = c(.6,.4), # relative heights of the two plots
shareX = TRUE, # plots will share an X axis
titleY = TRUE
) %>%
# create a vertical "spike line" to compare data across 2 plots
plotly::layout(
xaxis = list(
spikethickness = 1,
spikedash = "dot",
spikecolor = "black",
spikemode = "across+marker",
spikesnap = "cursor"
),
yaxis = list(spikethickness = 0)
)## Warning: Ignoring 1 observationsp_combinedSave the plot to pull into the index
#save(p_combined, file = "./plotly_fig.rda")Save an htmlwidget for website embedding
#htmlwidgets::saveWidget(p_combined, "plotly_fig.html")#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")#build a function here to make smooth frames so we don't repeat everything in huge loops
#FOR INDIVIDUAL FIGURES ONLY
make_n1_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")
return(smooth_n1)
}
make_n2_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")
return(smooth_n1)
}
#run frames through the functions
wrfa_smooth_n1 <- make_n1_smooth_frame(wrf_a_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n1 <- make_n1_smooth_frame(wrf_b_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n1 <- make_n1_smooth_frame(wrf_c_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfa_smooth_n2 <- make_n2_smooth_frame(wrf_a_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n2 <- make_n2_smooth_frame(wrf_b_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n2 <- make_n2_smooth_frame(wrf_c_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)Build loess smoothing figures figures
#COMBINED FIGURE ONLY
#create smoothing data frames
#n1
smooth_n1 <- only_n1 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#n2
smooth_n2 <- only_n2 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#**************************************COMBINED PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1 <- ggplot(smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 113)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2 <- ggplot(smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 113)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 3 rows containing non-finite values (stat_smooth).
fit_n1## [1] 10.75555 10.93590 11.11059 11.27954 11.44270 11.60001 11.75140 11.89680
## [9] 12.03616 12.16929 12.29518 12.41404 12.52642 12.63285 12.73389 12.83007
## [17] 12.92193 13.01004 13.09486 13.17630 13.25386 13.32703 13.39531 13.45820
## [25] 13.51519 13.56579 13.60950 13.64608 13.67574 13.69869 13.71516 13.72537
## [33] 13.72952 13.72785 13.72056 13.70574 13.67404 13.62774 13.57082 13.50727
## [41] 13.44105 13.37617 13.31660 13.26632 13.21668 13.15465 13.08396 13.00844
## [49] 12.93189 12.85814 12.79102 12.73434 12.69003 12.63401 12.56250 12.48142
## [57] 12.39672 12.31435 12.24026 12.18039 12.14068 12.11966 12.09919 12.07961
## [65] 12.06263 12.05000 12.04344 12.04468 12.05546 12.07758 12.12407 12.19863
## [73] 12.29388 12.40246 12.51701 12.63016 12.73454 12.82279 12.89244 12.97164
## [81] 13.06255 13.16084 13.26215 13.36214 13.45645 13.54074 13.61065 13.66783
## [89] 13.72120 13.77144 13.81902 13.86442 13.90813 13.95063 13.99240 14.03389
## [97] 14.07425 14.11294 14.14988 14.18497 14.21811 14.24922 14.27820 14.30496
## [105] 14.32946 14.35185 14.37215 14.39037 14.40655 14.42068 14.43278 14.44287
## [113] 14.45096#n2
extract_n2## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 3 rows containing non-finite values (stat_smooth).
fit_n2## [1] 10.65819 10.84351 11.02422 11.20027 11.37163 11.53825 11.70008 11.85708
## [9] 12.00920 12.15641 12.29877 12.43631 12.56901 12.69689 12.81994 12.93816
## [17] 13.05156 13.16014 13.26581 13.37211 13.47760 13.58065 13.67963 13.77291
## [25] 13.85887 13.93587 14.00235 14.06038 14.11172 14.15643 14.19456 14.22617
## [33] 14.25133 14.27010 14.28254 14.28665 14.27343 14.24503 14.20523 14.15783
## [41] 14.10660 14.05535 14.00785 13.96791 13.92527 13.86557 13.79350 13.71384
## [49] 13.63139 13.55095 13.47729 13.41522 13.36779 13.31343 13.24771 13.17498
## [57] 13.09958 13.02586 12.95817 12.90084 12.85823 12.82929 12.80081 12.77295
## [65] 12.74691 12.72386 12.70500 12.69152 12.68460 12.68545 12.69825 12.72365
## [73] 12.75897 12.80151 12.84858 12.89748 12.94552 12.99001 13.03111 13.08560
## [81] 13.15315 13.22945 13.31019 13.39108 13.46781 13.53607 13.59157 13.63734
## [89] 13.68400 13.73103 13.77764 13.82305 13.86651 13.90723 13.94445 13.97750
## [97] 14.00871 14.03904 14.06824 14.09603 14.12214 14.14631 14.16827 14.18775
## [105] 14.20465 14.21946 14.23224 14.24300 14.25172 14.25843 14.26311 14.26576
## [113] 14.26640#assign fits to a vector
n1_trend <- fit_n1
n2_trend <- fit_n2
#extract y min and max for each
limits_n1 <- ggplot_build(extract_n1)$data## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 3 rows containing non-finite values (stat_smooth).limits_n1 <- as.data.frame(limits_n1)
n1_ymin <- limits_n1$ymin
n1_ymax <- limits_n1$ymax
limits_n2 <- ggplot_build(extract_n2)$data## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 3 rows containing non-finite values (stat_smooth).limits_n2 <- as.data.frame(limits_n2)
n2_ymin <- limits_n2$ymin
n2_ymax <- limits_n2$ymax
#reassign dataframes (just to be safe)
work_n1 <- smooth_n1
work_n2 <- smooth_n2
#fill in missing dates to smooth fits
work_n1 <- work_n1 %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1 <- work_n1$date
work_n2 <- work_n2 %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2 <- work_n2$date
#create a new smooth dataframe to layer
smooth_frame_n1 <- data.frame(date_vec_n1, n1_trend, n1_ymin, n1_ymax)
smooth_frame_n2 <- data.frame(date_vec_n2, n2_trend, n2_ymin, n2_ymax)#make plotlys
#**************************************COMBINED PLOT**********************************************
#plot smooth frames
p3 <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1, y = ~n1_trend,
data = smooth_frame_n1,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1,
'</br> Median Log Copies: ', round(n1_trend, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_lines(x = ~date_vec_n2, y = ~n2_trend,
data = smooth_frame_n2,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2,
'</br> Median Log Copies: ', round(n2_trend, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1, ymin = ~n1_ymin, ymax = ~n1_ymax,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymax, digits = 2),
'</br> Min Log Copies: ', round(n1_ymin, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2, ymin = ~n2_ymin, ymax = ~n2_ymax,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymax, digits = 2),
'</br> Min Log Copies: ', round(n2_ymin, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_ymin), yend = ~max(n1_ymax),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_ymin), yend = ~max(n1_ymax),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_ymin), yend = ~max(n1_ymax),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p3## Warning: Ignoring 3 observations
## Warning: Ignoring 3 observationsCreate final trend plot by stacking with epidemic curve
smooth_extracttest <-
plotly::subplot(p3,p1, # plots to combine, top to bottom
nrows = 2,
heights = c(.6,.4), # relative heights of the two plots
shareX = TRUE, # plots will share an X axis
titleY = TRUE
) %>%
# create a vertical "spike line" to compare data across 2 plots
plotly::layout(
xaxis = list(
spikethickness = 1,
spikedash = "dot",
spikecolor = "black",
spikemode = "across+marker",
spikesnap = "cursor"
),
yaxis = list(spikethickness = 0)
)## Warning: Ignoring 3 observations
## Warning: Ignoring 3 observations## Warning: Ignoring 1 observationssmooth_extracttest#save(smooth_extracttest, file = "./smooth_extracttest.rda")This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1a <- ggplot(wrfa_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 113)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2a <- ggplot(wrfa_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 113)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1a## `geom_smooth()` using formula 'y ~ x'
fit_n1a## [1] 10.92373 11.04102 11.15365 11.26133 11.36372 11.46051 11.55139 11.63604
## [9] 11.71393 11.78526 11.85077 11.91117 11.96722 12.01965 12.06919 12.11310
## [17] 12.14861 12.17643 12.19725 12.21176 12.22065 12.22464 12.22440 12.22064
## [25] 12.21405 12.20533 12.19518 12.18429 12.17335 12.15729 12.13175 12.09855
## [33] 12.05949 12.01637 11.97099 11.92516 11.88069 11.83938 11.80302 11.77344
## [41] 11.75242 11.74178 11.74331 11.75291 11.76531 11.78058 11.79879 11.82003
## [49] 11.84436 11.87187 11.90262 11.93669 11.97415 12.01509 12.05958 12.10768
## [57] 12.15948 12.21991 12.29258 12.37555 12.46689 12.56469 12.66700 12.77191
## [65] 12.87747 12.98177 13.08288 13.17886 13.26778 13.34773 13.41676 13.48472
## [73] 13.56110 13.64343 13.72926 13.81614 13.90160 13.98319 14.05845 14.12494
## [81] 14.18018 14.22172 14.24711 14.25389 14.23961 14.20849 14.16670 14.11470
## [89] 14.05291 13.98179 13.90179 13.81334 13.71689 13.61290 13.50179 13.38402
## [97] 13.26004 13.13028 12.99520 12.85366 12.70427 12.54704 12.38198 12.20912
## [105] 12.02847 11.84006 11.64389 11.43999 11.22838 11.00906 10.78207 10.54742
## [113] 10.30512#n2
extract_n2a## `geom_smooth()` using formula 'y ~ x'
fit_n2a## [1] 10.43568 10.67374 10.90378 11.12566 11.33925 11.54439 11.74096 11.92881
## [9] 12.10763 12.27741 12.43851 12.59126 12.73601 12.87311 13.00290 13.12511
## [17] 13.23925 13.34532 13.44334 13.53333 13.61529 13.68924 13.75519 13.81315
## [25] 13.86313 13.90515 13.93923 13.96536 13.98356 13.98570 13.96569 13.92668
## [33] 13.87181 13.80423 13.72707 13.64346 13.55656 13.46951 13.38543 13.30748
## [41] 13.23880 13.18251 13.14177 13.10697 13.06725 13.02393 12.97828 12.93161
## [49] 12.88521 12.84038 12.79840 12.76058 12.72820 12.70256 12.68496 12.67670
## [57] 12.67905 12.69519 12.72601 12.76937 12.82316 12.88526 12.95354 13.02588
## [65] 13.10016 13.17426 13.24606 13.31343 13.37426 13.42642 13.46778 13.50782
## [73] 13.55595 13.61003 13.66790 13.72741 13.78640 13.84271 13.89419 13.93870
## [81] 13.97406 13.99813 14.00874 14.00376 13.98102 13.94397 13.89786 13.84321
## [89] 13.78056 13.71042 13.63333 13.54981 13.46039 13.36559 13.26595 13.16199
## [97] 13.05424 12.94322 12.82946 12.71165 12.58814 12.45898 12.32419 12.18381
## [105] 12.03788 11.88643 11.72950 11.56712 11.39933 11.22617 11.04767 10.86387
## [113] 10.67480#assign fits to a vector
n1_trenda <- fit_n1a
n2_trenda <- fit_n2a
#extract y min and max for each
limits_n1a <- ggplot_build(extract_n1a)$data## `geom_smooth()` using formula 'y ~ x'limits_n1a <- as.data.frame(limits_n1a)
n1_ymina <- limits_n1a$ymin
n1_ymaxa <- limits_n1a$ymax
limits_n2a <- ggplot_build(extract_n2a)$data## `geom_smooth()` using formula 'y ~ x'limits_n2a <- as.data.frame(limits_n2a)
n2_ymina <- limits_n2a$ymin
n2_ymaxa <- limits_n2a$ymax
#reassign dataframes (just to be safe)
work_n1a <- wrfa_smooth_n1
work_n2a<- wrfa_smooth_n1
#fill in missing dates to smooth fits
work_n1a <- work_n1a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1a <- work_n1a$date
work_n2a <- work_n2a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2a <- work_n2a$date
#create a new smooth dataframe to layer
smooth_frame_n1a <- data.frame(date_vec_n1a, n1_trenda, n1_ymina, n1_ymaxa)
smooth_frame_n2a <- data.frame(date_vec_n2a, n2_trenda, n2_ymina, n2_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1a, y = ~n1_trenda,
data = smooth_frame_n1a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a,
'</br> Median Log Copies: ', round(n1_trenda, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_lines(x = ~date_vec_n2a, y = ~n2_trenda,
data = smooth_frame_n2a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a,
'</br> Median Log Copies: ', round(n2_trenda, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1a, ymin = ~n1_ymina, ymax = ~n1_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n1_ymina, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2a, ymin = ~n2_ymina, ymax = ~n2_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n2_ymina, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1b <- ggplot(wrfb_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 113)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2b <- ggplot(wrfb_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 113)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1b## `geom_smooth()` using formula 'y ~ x'
fit_n1b## [1] 10.47219 10.64549 10.81207 10.97184 11.12472 11.27063 11.40950 11.54123
## [9] 11.66560 11.78264 11.89261 11.99579 12.09245 12.18286 12.26729 12.34573
## [17] 12.41794 12.48384 12.54334 12.59636 12.64281 12.68261 12.71568 12.74192
## [25] 12.76126 12.77362 12.77890 12.77703 12.76792 12.74276 12.69518 12.62869
## [33] 12.54679 12.45302 12.35089 12.24391 12.13561 12.02950 11.92911 11.83794
## [41] 11.75951 11.69735 11.65497 11.62175 11.58552 11.54747 11.50880 11.47072
## [49] 11.43441 11.40107 11.37191 11.34811 11.33088 11.32141 11.32090 11.33054
## [57] 11.35154 11.39095 11.45285 11.53400 11.63115 11.74107 11.86050 11.98620
## [65] 12.11492 12.24342 12.36846 12.48678 12.59514 12.69030 12.76901 12.83830
## [73] 12.90703 12.97472 13.04085 13.10495 13.16651 13.22504 13.28005 13.33103
## [81] 13.37750 13.41895 13.45490 13.48485 13.50830 13.52741 13.54430 13.55842
## [89] 13.56923 13.57618 13.57874 13.57635 13.56847 13.55455 13.53406 13.50645
## [97] 13.47117 13.42767 13.37542 13.31574 13.25029 13.17906 13.10204 13.01921
## [105] 12.93055 12.83605 12.73568 12.62943 12.51728 12.39923 12.27524 12.14530
## [113] 12.00940#n2
extract_n2b## `geom_smooth()` using formula 'y ~ x'
fit_n2b## [1] 10.36875 10.52661 10.67934 10.82731 10.97092 11.11053 11.24652 11.37929
## [9] 11.50931 11.63637 11.75976 11.87880 11.99277 12.10099 12.20275 12.30077
## [17] 12.39769 12.49275 12.58518 12.67420 12.75905 12.83894 12.91310 12.98077
## [25] 13.04117 13.09353 13.13708 13.17104 13.19464 13.20280 13.19256 13.16635
## [33] 13.12660 13.07576 13.01623 12.95047 12.88090 12.80994 12.74004 12.67362
## [41] 12.61312 12.56096 12.51958 12.47405 12.41021 12.33157 12.24168 12.14407
## [49] 12.04227 11.93983 11.84026 11.74711 11.66392 11.59421 11.54152 11.50939
## [57] 11.50134 11.52078 11.56636 11.63450 11.72165 11.82423 11.93868 12.06143
## [65] 12.18891 12.31755 12.44379 12.56406 12.67479 12.77241 12.85335 12.92778
## [73] 13.00721 13.09009 13.17487 13.25999 13.34391 13.42508 13.50194 13.57294
## [81] 13.63655 13.69119 13.73533 13.76742 13.78589 13.79537 13.80104 13.80227
## [89] 13.79840 13.78879 13.77278 13.74973 13.71899 13.67991 13.63185 13.57414
## [97] 13.50615 13.42723 13.33672 13.23617 13.12753 13.01076 12.88583 12.75271
## [105] 12.61137 12.46178 12.30390 12.13771 11.96317 11.78024 11.58891 11.38913
## [113] 11.18088#assign fits to a vector
n1_trendb <- fit_n1b
n2_trendb <- fit_n2b
#extract y min and max for each
limits_n1b <- ggplot_build(extract_n1b)$data## `geom_smooth()` using formula 'y ~ x'limits_n1b <- as.data.frame(limits_n1b)
n1_yminb <- limits_n1b$ymin
n1_ymaxb <- limits_n1b$ymax
limits_n2b <- ggplot_build(extract_n2b)$data## `geom_smooth()` using formula 'y ~ x'limits_n2b <- as.data.frame(limits_n2b)
n2_yminb <- limits_n2b$ymin
n2_ymaxb <- limits_n2b$ymax
#reassign dataframes (just to be safe)
work_n1b <- wrfb_smooth_n1
work_n2b<- wrfb_smooth_n1
#fill in missing dates to smooth fits
work_n1b <- work_n1b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1b <- work_n1b$date
work_n2b <- work_n2b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2b <- work_n2b$date
#create a new smooth dataframe to layer
smooth_frame_n1b <- data.frame(date_vec_n1b, n1_trendb, n1_yminb, n1_ymaxb)
smooth_frame_n2b <- data.frame(date_vec_n2b, n2_trendb, n2_yminb, n2_ymaxb)
#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1b, y = ~n1_trendb,
data = smooth_frame_n1b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b,
'</br> Median Log Copies: ', round(n1_trendb, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_lines(x = ~date_vec_n2b, y = ~n2_trendb,
data = smooth_frame_n2b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b,
'</br> Median Log Copies: ', round(n2_trendb, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1b, ymin = ~n1_yminb, ymax = ~n1_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n1_yminb, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2b, ymin = ~n2_yminb, ymax = ~n2_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n2_yminb, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")save(smooth_frame_n1a, file = "./plotly_objs/smooth_frame_n1a.rda")
save(smooth_frame_n2a, file = "./plotly_objs/smooth_frame_n2a.rda")
save(smooth_frame_n1b, file = "./plotly_objs/smooth_frame_n1b.rda")
save(smooth_frame_n2b, file = "./plotly_objs/smooth_frame_n2b.rda")save(date_vec_n1a, file = "./plotly_objs/date_vec_n1a.rda")
save(date_vec_n2a, file = "./plotly_objs/date_vec_n2a.rda")
save(date_vec_n1b, file = "./plotly_objs/date_vec_n1b.rda")
save(date_vec_n2b, file = "./plotly_objs/date_vec_n2b.rda")save(n1_ymina, file = "./plotly_objs/n1_ymina.rda")
save(n1_ymaxa, file = "./plotly_objs/n1_ymaxa.rda")
save(n2_ymina, file = "./plotly_objs/n2_ymina.rda")
save(n2_ymaxa, file = "./plotly_objs/n2_ymaxa.rda")
save(n1_yminb, file = "./plotly_objs/n1_yminb.rda")
save(n1_ymaxb, file = "./plotly_objs/n1_ymaxb.rda")
save(n2_yminb, file = "./plotly_objs/n2_yminb.rda")
save(n2_ymaxb, file = "./plotly_objs/n2_ymaxb.rda")#**************************************WRF C PLOT********************************************** Does not work until raw data fixed #add trendlines #extract data from geom_smooth #n1 extract # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS************************* extract_n1c <- ggplot(wrfc_smooth_n1, aes(x = date, y = log_sum_copies_L)) + stat_smooth(aes(outfit=fit_n1c<<-..y..), method = “loess”, color = ‘#1B9E77’, span = 0.6, n = 113) #n2 extract extract_n2c <- ggplot(wrfc_smooth_n2, aes(x = date, y = log_sum_copies_L)) + stat_smooth(aes(outfit=fit_n2c<<-..y..), method = “loess”, color = ‘#1B9E77’, span = 0.6, n = 113)
#look at the fits to align dates and total observations #n1 extract_n1c fit_n1c #n2 extract_n2c fit_n2c
#assign fits to a vector n1_trendc <- fit_n1c n2_trendc <- fit_n2c
#extract y min and max for each limits_n1c <- ggplot_build(extract_n1c)\(data limits_n1c <- as.data.frame(limits_n1c) n1_yminc <- limits_n1c\)ymin n1_ymaxc <- limits_n1c$ymax
limits_n2c <- ggplot_build(extract_n2c)\(data limits_n2c <- as.data.frame(limits_n2c) n2_yminc <- limits_n2c\)ymin n2_ymaxc <- limits_n2c$ymax
#reassign dataframes (just to be safe) work_n1c <- wrfc_smooth_n1 work_n2c <- wrfc_smooth_n1
#fill in missing dates to smooth fits work_n1c <- work_n1c %>% complete(date = seq(min(date), max(date), by = “1 day”)) date_vec_n1c <- work_n1c\(date work_n2c <- work_n2c %>% complete(date = seq(min(date), max(date), by = "1 day")) date_vec_n2c <- work_n2c\)date
#create a new smooth dataframe to layer smooth_frame_n1c <- data.frame(date_vec_n1c, n1_trendc, n1_yminc, n1_ymaxc) smooth_frame_n2c <- data.frame(date_vec_n2c, n2_trendc, n2_yminc, n2_ymaxc)
#WRF C #plot smooth frames p_wrf_c <- plotly::plot_ly() %>% plotly::add_lines(x = ~date_vec_n1c, y = ~n1_trendc, data = smooth_frame_n1c, hoverinfo = “text”, text = ~paste(‘ Date:’, date_vec_n1c, ‘ Median Log Copies:’, round(n1_trendc, digits = 2), ‘ Target: N1’), line = list(color = ‘#1B9E77’, size = 8, opacity = 0.65), showlegend = FALSE) %>% plotly::add_lines(x = ~date_vec_n2c, y = ~n2_trendc, data = smooth_frame_n2c, hoverinfo = “text”, text = ~paste(‘ Date:’, date_vec_n2c, ‘ Median Log Copies:’, round(n2_trendc, digits = 2), ‘ Target: N2’), line = list(color = ‘#D95F02’, size = 8, opacity = 0.65), showlegend = FALSE) %>% plotly::add_ribbons(x ~date_vec_n1c, ymin = ~n1_yminc, ymax = ~n1_ymaxc, showlegend = FALSE, opacity = 0.25, hoverinfo = “text”, text = ~paste(‘ Date:’, date_vec_n1b, #leaving in case we want to change ‘ Max Log Copies:’, round(n1_ymaxc, digits = 2), ‘ Min Log Copies:’, round(n1_yminc, digits = 2), ‘ Target: N1’), name = "“, line = list(color = ‘#1B9E77’)) %>% plotly::add_ribbons(x ~date_vec_n2c, ymin = ~n2_yminc, ymax = ~n2_ymaxc, showlegend = FALSE, opacity = 0.25, hoverinfo =”text“, text = ~paste(‘ Date:’, date_vec_n2b, #leaving in case we want to change ‘ Max Log Copies:’, round(n2_ymaxc, digits = 2), ‘ Min Log Copies:’, round(n2_yminc, digits = 2), ‘ Target: N2’), name =”“, line = list(color = ‘#D95F02’)) %>% layout(yaxis = list(title =”Total Log SARS CoV-2 Copies“, showline = TRUE, automargin = TRUE)) %>% layout(xaxis = list(title =”Date“)) %>% layout(title =”WRF C“) %>% plotly::add_segments(x = as.Date(”2020-06-24“), xend = as.Date(”2020-06-24“), y = ~min(n1_yminc), yend = ~max(n1_ymaxc), opacity = 0.35, name =”Bars Repoen“, hoverinfo =”text“, text =” Bars Reopen“,” 2020-06-24“, showlegend = FALSE, line = list(color =”black“, dash =”dash“)) %>% plotly::add_segments(x = as.Date(”2020-07-09“), xend = as.Date(”2020-07-09“), y = ~min(n1_yminc), yend = ~max(n1_ymaxc), opacity = 0.35, name =”Mask Mandate“, hoverinfo =”text“, text =” Mask Mandate“,” 2020-07-09“, showlegend = FALSE, line = list(color =”black“, dash =”dash“)) %>% plotly::add_segments(x = as.Date(”2020-08-20“), xend = as.Date(”2020-08-20“), y = ~min(n1_yminc), yend = ~max(n1_ymaxc), opacity = 0.35, name =” Classes Begin“,” 2020-08-20“, hoverinfo =”text“, text =”Classes Begin“, showlegend = FALSE, line = list(color =”black“, dash =”dash“)) %>% plotly::add_markers(x = ~date, y = ~log_sum_copies_L, data = wrfc_smooth_n1, hoverinfo =”text“, showlegend = FALSE, text = ~paste(‘ Date:’, date, ‘ Actual Log Copies:’, round(log_sum_copies_L, digits = 2)), marker = list(color = ‘#1B9E77’, size = 6, opacity = 0.65)) %>% plotly::add_markers(x = ~date, y = ~log_sum_copies_L, data = wrfc_smooth_n2, hoverinfo =”text", showlegend = FALSE, text = ~paste(‘ Date:’, date, ‘ Actual Log Copies:’, round(log_sum_copies_L, digits = 2)), marker = list(color = ‘#D95F02’, size = 6, opacity = 0.65))
p_wrf_c